﻿////////////////////////////////////////////////////////////
//  Модуль пошаговых вычислений (реализация)
//  Василий Кудрявцев
//  Последнее изменение: 20 декабря 2008 года
//

#light "off"

namespace Fp

module FpEvalStep

open FpCore
open Fp_parser
open Fp_lexer
open FpEval
open Microsoft.FSharp.Compatibility.OCaml.Lexing
open System



//Делает один шаг в вычислении выражения
// Возвращает результат вычисления в виде строки
let rec  evalstep inexpr = 
match inexpr with     
  | Void | T | F as s -> (string_of_expr s, String.Empty)
  | Int n   ->  (string_of_expr (Int n), String.Empty)
  | Var v   -> (string_of_expr (Var v), "Подстановка")
  | Seq posl   ->  eval_sequence_step  posl//( ("< " ^ (List.reduce_left    (fun l  r  -> l ^ ", " ^ r)  (List.map (evalstep >> first) posl) ) ^ ">"),  "Sequence") //Тут вычисляться все элементы, а не по очереди!
  | App(fct,e)->   evalstep_fct fct  e  

and evalstep_fct fct e =
 try
 let s1, comment = evalstep e in
 let s2 = string_of_expr e in
 if  s1 = s2 //Сначала всегда вычисляем аргумент
 then
       match fct with 
            
            (* functional forms *)
            
          | Insert fct      -> (string_of_expr (insert fct e), "Вставка") //OPEN?
          | ApplyToAll fct  -> (match e with
                                |Seq s ->  ("< " ^ (List.reduce_left   (fun l r  -> l ^ ", " ^ r)  (List.map (fun  element -> (string_of_fct fct) ^":"^ (string_of_expr element)) s ) )  ^ ">", "Map")
                                | _ -> raise (Eval_bottom e))
          | Composition(f1,f2) -> ((string_of_fct f1) ^ ":(" ^ fst(evalstep_fct f2 e)    ^ ")", "Композиция")
          | Construction l -> ("< " ^ (List.reduce_left   (fun l r  -> l ^ ", " ^ r) (List.map (fun o -> (string_of_fct o) ^ ":" ^  (string_of_expr e)) l)) ^ ">", "Конструкция")
          | Constant e ->  evalstep e
          | Condition(p,f,g) -> 
             let res = if (eval_fct p e) = T then
                   (string_of_fct f) ^":"^  string_of_expr(e) else  (string_of_fct g) ^":"^  string_of_expr(e)
             in (res, "Условие")
          | Bu(f,o) -> evalstep_fct f (Seq [ o; e ])
          | While(p,f) -> 
          let re = ref e in 
             while (eval_fct p !re) = T
             do re := eval_fct f !re
              done; 
           (string_of_expr (eval !re), "Цикл while");

          | Prim s -> (string_of_expr (eval_prim s e),  "Встроенная функция")
          | Sel  n -> (string_of_expr(match_seq e (fun l -> List.nth l (n-1))) , "Выбор")
          | RSel n -> (string_of_expr(match_seq e (fun l -> List.nth l ((List.length l) - n)) ), "Выбор")
          | User s -> (string_of_fct(try get_user_def s with Not_found -> raise (Eval_error (App(fct,e))))  ^ ":" ^ (string_of_expr e), "Пользовательская функция")
                   
          else 
             ((string_of_fct fct) ^ ":" ^ s1, comment)
with
  | Eval_error e -> raise (Eval_error e);
  | _ -> raise (Eval_bottom (App(fct,e)))
  
  
and
//В последовательности находим первый член, который можно преобразовать и вычисляем только его
 eval_sequence_step (posl :list<expr>)  =
 let first_to_change = 
  try (List.find_index (fun x -> fst(evalstep x) <> (string_of_expr x)) posl)
  with _-> -1
   in
 let re = ref [] in
 let mutable comment = String.Empty in
 for i = 0 to List.length(posl)-1 do
  if i = first_to_change then
     let res, comment = evalstep(List.nth posl i) in
     re :=  (res :: !re);
  else
     re :=  (string_of_expr(List.nth posl i) :: !re)
 done;
  //Строим из списка строк одну строку
 let resultingExp=  "< " ^ (List.reduce_left    (fun l  r  -> l ^ ", " ^ r)  (List.rev !re) ) ^ ">" in
 (resultingExp , comment);;
 


//Делает один шаг в вычислении выражения заданного строкой
// Возвращает результат вычисления в виде строки
let step line =
 let lexbuf = from_string (line^"\n") in
 let expr  =  exp lexer (lexbuf) in
 evalstep expr;;
